home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / filesets.tcl.back < prev    next >
Encoding:
Text File  |  1994-07-07  |  4.7 KB  |  144 lines  |  [TEXT/ALFA]
  1. #===============================================================================================
  2. # Create new filesets either by the "Utils:Add Fileset..." menu item. These 
  3. # filesets can be made permanent by "Utils:Dump Fileset..."ing the fileset 
  4. # to immediately below.
  5. #
  6. # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  7. # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  8. # on occasion, but this isn't critical.
  9. #===============================================================================================
  10.  
  11. #===========================================================================
  12. # The filesets.
  13. #===========================================================================
  14.  
  15. # Build some filesets on the fly.
  16. catch {unset fileSets}
  17. catch {unset currFileSet}
  18. catch {set fileSets(HomeDir) [glob -t TEXT $HOME:*]}
  19. catch {set fileSets(Help) [glob -t TEXT "$HOME:*"]}
  20. catch {set fileSets(System) [glob -t TEXT "$HOME:Tcl:SystemCode:*.tcl"]}
  21. catch {set fileSets(User) [glob -t TEXT "$HOME:Tcl:UserCode:*.tcl"]}
  22.  
  23. catch {set currFileSet [lindex [array names fileSets] 0]}
  24.  
  25. # Example dumped fileset (these files won't exist on your machine). 
  26. set fileSets(AltHelp) {
  27.     "Internal:Development:Alpha:Help:Alpha Commands"
  28.     "Internal:Development:Alpha:Help:Customizing"
  29.     "Internal:Development:Alpha:Help:Debugging"
  30.     "Internal:Development:Alpha:Help:Default Key Bindings"
  31.     "Internal:Development:Alpha:Help:electricAlias Help"
  32.     "Internal:Development:Alpha:Help:General Help"
  33.     "Internal:Development:Alpha:Help:LaTeX Help"
  34.     "Internal:Development:Alpha:Help:Regular Expressions"
  35.     "Internal:Development:Alpha:Help:Shells"
  36.     "Internal:Development:Alpha:Help:Tcl"
  37.     "Internal:Development:Alpha:Help:Tcl Library - auto-loading"
  38.     "Internal:Development:Alpha:Help:Tcl Mailing List"
  39.     "Internal:Development:Alpha:Help:XTCLs"
  40. }
  41.  
  42. # Insert your filesets here...
  43.  
  44.  
  45.  
  46. #===========================================================================
  47. # The support routines.
  48. #===========================================================================
  49. # Called from Alpha to get list of files for current file set.
  50. proc getCurrFileSet {} {
  51.     global fileSets
  52.     global currFileSet
  53.     return $fileSets($currFileSet)
  54. }
  55.  
  56. # Called from Alpha to get names. The first name returned is taken to 
  57. # be the current fileset.
  58. proc getFileSetNames {} {
  59.     global fileSets
  60.     global currFileSet
  61.     set ind [lsearch [array names fileSets] $currFileSet]
  62.     if {$ind < 0} {set ind 0}
  63.     return [linsert [lsort [lreplace [array names fileSets] $ind $ind]] 0 $currFileSet]
  64. }
  65.  
  66.  
  67. # Keep 'fileSets' menu up to date.
  68. trace vdelete currFileSet w shadowCurrFileSet
  69. trace variable currFileSet w shadowCurrFileSet
  70. proc shadowCurrFileSet {nm1 nm2 op} {
  71.     global fileSets
  72.     global currFileSet
  73.     foreach name [array names fileSets] {
  74.         if {$name == $currFileSet} {
  75.             markMenuItem fileSets $name on
  76.         } else {
  77.             markMenuItem fileSets $name off
  78.         }
  79.     }
  80.     return $currFileSet
  81. }
  82.  
  83. # Called in response to user changing filesets from the fileset menu.
  84. proc changeFileSet {menu item} {
  85.     global fileSetNames
  86.     global currFileSet
  87.     
  88.     set currFileSet $item
  89. }
  90.  
  91.  
  92. #===========================================================================
  93. # Add fileset.
  94. #===========================================================================
  95. proc createFileset {} {
  96.     global fileSets
  97.     global currFileSet
  98.     
  99.     set name [getline "New fileset name:" ""]
  100.     if {![string length $name]} return
  101.     
  102.     set dir [get_directory]
  103.     if {![string length $dir]} return
  104.     
  105.     set filePat [getline "File pattern:" "*"]
  106.     if {![string length $filePat]} return
  107.     
  108.     set fileSets($name) [glob "$dir:$filePat"]
  109.     menu -n fileSets -m -p changeFileSet [lsort [array names fileSets]]
  110.     set currFileSet $name
  111.  
  112.     if {[askyesno "Save new fileset?"] == "yes"} {
  113.         addUserLine "set fileSets($name) \[glob -t TEXT \"$dir:$filePat\"\]"
  114.         addUserLine "addMenuItem -m fileSets \"$name\""
  115.     }
  116. }
  117.  
  118.  
  119. #===========================================================================
  120. # Dump fileset to current window. If you dump at the end of this file,
  121. # the fileset will be reloaded the next time you run Alpha.
  122. #===========================================================================
  123. proc dumpFileset {} {
  124.     global fileSets
  125.     global currFileSet
  126.     if {![catch {prompt "Fileset name:" $currFileSet} name]} {
  127.         insertText "set fileSets(" $name ") \{\r"
  128.         foreach file $fileSets($name) {
  129.             insertText "\t\"$file\"\r"
  130.         }
  131.         insertText "\}\r"
  132.     }
  133. }
  134.  
  135.  
  136.  
  137. #===========================================================================
  138. # Must stay the last thing in the file! We need this so that all the 
  139. # filesets defined above make it into the menu.
  140. #===========================================================================
  141. menu -n fileSets -m -p changeFileSet [lsort [array names fileSets]]
  142. markMenuItem fileSets $currFileSet on
  143.  
  144.